Giga Games 1/Giga Games.iso/net/usenet/volume3/go/part05

Internet Message Format | 1988-03-09 | 18.1 KB

Path: uunet!husc6!bloom-beacon!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request
From: [e-mail]
Newsgroups: comp.sources.games
Subject: v03i101:  go - go board manager sources, Part05/05
Message-ID: <[e-mail]>
Date: 9 Mar 88 17:58:19 GMT
Sender: [e-mail]
Lines: 703
Approved: [e-mail]

Submitted by: Fred Hansen <[e-mail]>
Comp.sources.games: Volume 3, Issue 101
Archive-name: go/Part05


#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 5 (of 5)."
# Contents:  goMenu.pas
# Wrapped by billr@saab on Wed Mar  9 09:14:47 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f goMenu.pas -a "${1}" != "-c" ; then
  echo shar: Will not over-write existing file \"goMenu.pas\"
else
echo shar: Extracting \"goMenu.pas\" \(16045 characters\)
sed "s/^X//" >goMenu.pas <<'END_OF_goMenu.pas'
X{---------------------------------------------------------------}
X{ Go Menu Manager                                               }
X{ Copyright (c) 1982 by Three Rivers Computer Corp.             }
X{                                                               }
X{ Written: December 3, 1982 by Stoney Ballard                   }
X{ Edit History:                                                 }
X{                                                               }
X{   Jan  5, 1983 - Fixed bug in menu select                     }
X{   Jan 27, 1983 - added setPlayLevel                           }
X{---------------------------------------------------------------}
X
Xmodule goMenu;
X
Xexports
X
Ximports fileDefs from fileDefs;
Ximports goTree from goTree;
X
Xprocedure initMenu;
Xfunction getMenuCmd: integer;
Xprocedure endCmd;
Xprocedure putMString(cmd: integer; ms: string);
Xprocedure activate(cmd: integer; act: boolean);
Xprocedure restoreCursor;
Xfunction confirmed: boolean;
Xfunction menuGoFile(var fName: pathName): boolean;
Xprocedure waitNoButton;
Xprocedure waitButton;
Xprocedure clearLine(ln: integer);
Xprocedure prompt(s: string);
Xprocedure showComment;
Xprocedure showTag;
Xfunction getHCMenu: integer;
Xfunction getTagMenu: tagPtr;
Xprocedure setMenuCursor;
Xprocedure menuPlayLevel(var playLevel: integer; maxLevel: integer);
X
Xprivate
X
Ximports goCom from goCom;
Ximports goMgr from goMgr;
Ximports popUp from popUp;
Ximports raster from raster;
Ximports screen from screen;
Ximports IO_Others from IO_Others;
Ximports fileSystem from fileSystem;
Ximports fileUtils from fileUtils;
Ximports perq_String from perq_String;
X
Xconst
X  mWidth = 180;
X  mHeight = 18;
X  mLBorder = 12;
X  mTBorder = 10;
X  mVSpacing = mHeight + 4;
X  mHSpacing = mWidth + 8;
X  grHeight = mHeight - 2;
X  grWidth = (((mWidth - 2 + 15) div 16 + 3) div 4) * 4;
X
Xtype
X  mStr = string[20];
X
X  menuBox = record
X              leftX, topY, rightX, botY: integer;
X              isAct: boolean;
X              str: mStr;
X            end;
X
X  greyPat = array[0..grHeight - 1] of array[0..grWidth - 1] of integer;
X  pGreyPat = ^greyPat;
X
Xvar
X  mItems: array[1..mLast] of menuBox;
X  curHiLi, curCmd: integer;
X  mGreyP: pGreyPat;
X  isMenuCursor: boolean;
X  valDesc: pNameDesc;
X  cnfDesc: pNameDesc;
X  res: resRes;
X  goFNames: array[1..1024] of string[25];
X  tabXPos, tabYPos: integer;
X
Xprocedure restoreCursor;
Xbegin { restoreCursor }
X  if isMenuCursor then
X    IOLoadCursor(defaultCursor, 0, 0)
X  else
X    IOLoadCursor(selCursor, curC, curC);
Xend { restoreCursor };
X
Xprocedure waitNoButton;
Xbegin { waitNoButton }
X  while tabYellow or tabWhite or tabGreen or tabBlue or tabSwitch do;
Xend { waitNoButton };
X
Xprocedure waitButton;
Xbegin { waitButton }
X  while not tabSwitch do;
Xend { waitButton };
X
Xprocedure menuPlayLevel(var playLevel: integer; maxLevel: integer);
Xvar
X  plMenu: pNameDesc;
X  i: integer;
X  res: resres;
X
X  handler outside;
X  begin { outside }
X    destroyNameDesc(plMenu);
X    write(''); {control-G}
X    waitNoButton;
X    exit(menuPlayLevel);
X  end { outside };
X
Xbegin { menuPlayLevel }
X  allocNameDesc(maxLevel + 1, 0, plMenu);
X  plMenu^.header := 'Play Level?';
X  for i := 0 to maxLevel do
X    begin
X{$R-}
X      plMenu^.commands[i + 1] := intToStr(i);
X{$R=}
X    end;
X  menu(plMenu, false, 1, maxLevel + 1, -1, -1, -1, res);
X  playLevel := res^.indices[1] - 1;
X  destroyRes(res);
X  destroyNameDesc(plMenu);
Xend { menuPlayLevel };
X
Xfunction getTagMenu: tagPtr;
Xvar
X  tp: tagPtr;
X  nTags, tIdx, i: integer;
X  tMenu: pNameDesc;
X  res: resres;
X
X  handler outside;
X  begin { outside }
X    destroyNameDesc(tMenu);
X    write(''); {control-G}
X    waitNoButton;
X    exit(getTagMenu);
X  end { outside };
X
Xbegin { getTagMenu }
X  getTagMenu := nil;
X  tp := treeRoot^.lastTag;
X  nTags := 0;
X  while tp <> nil do
X    begin
X      nTags := nTags + 1;
X      tp := tp^.nextTag;
X    end;
X  if nTags = 0 then
X    write('') {control-G}
X  else
X    begin
X      tp := treeRoot^.lastTag;
X      allocNameDesc(nTags, 0, tMenu);
X      tMenu^.header := 'Which Tag?';
X      for i := nTags downTo 1 do
X        begin
X{$R-}
X          tMenu^.commands[i] := tp^.sTag;
X{$R=}
X          tp := tp^.nextTag;
X        end;
X      menu(tMenu, false, 1, nTags, -1, -1, -1, res);
X      restoreCursor;
X      tIdx := nTags - res^.indices[1];
X      destroyRes(res);
X      destroyNameDesc(tMenu);
X      tp := treeRoot^.lastTag;
X      for i := 1 to tIdx do
X        tp := tp^.nextTag;
X      getTagMenu := tp;
X    end;
Xend { getTagMenu };
X
Xprocedure clearLine(ln: integer);
Xvar
X  lY: integer;
Xbegin { clearLine }
X  lY := winTable[statWin].winTY +
X        (ln * (charHeight + lineDel)) + lineY - charHeight;
X  rasterop(RAndNot, sWinW - promptX - 32, charHeight,
X                    promptX, lY, SScreenW, SScreenP,
X                    promptX, lY, SScreenW, SScreenP);
Xend { clearLine };
X
Xprocedure posLine(ln: integer);
Xvar
X  lY: integer;
Xbegin { posLine }
X  clearLine(ln);
X  lY := winTable[statWin].winTY + (ln * (charHeight + lineDel)) + lineY;
X  SSetCursor(promptX, lY);
Xend { posLine };
X
Xprocedure prompt(s: string);
Xbegin { prompt }
X  posLine(promptLine);
X  write(s);
Xend { prompt };
X
Xprocedure showTag;
Xvar
X  ts: string;
Xbegin { showTag }
X  posLine(tagLine);
X  if getTag(curMove, ts) then
X    write('Tag: ', ts);
Xend { showTag };
X
Xprocedure showComment;
Xvar
X  cs: string;
Xbegin { showComment }
X  posLine(cmtLine);
X  if getComment(curMove, cs) then
X    write('Comment: ', cs);
Xend { showComment };
X
Xfunction getHCMenu: integer;
Xvar
X  res: resres;
X
X  handler outside;
X  begin { outside }
X    restoreCursor;
X    getHCMenu := none;
X    write(''); {control-G}
X    exit(getHCMenu);
X  end { outside };
X
Xbegin { getHCMenu }
X  menu(valDesc, false, 1, 8, -1, -1, -1, res);
X  restoreCursor;
X  getHCMenu := res^.indices[1] + 1;
X  destroyRes(res);
Xend { getHCMenu };
X
Xfunction menuGoFile(var fName: pathName): boolean;
Xvar
X  fi, i: integer;
X  fid: fileID;
X  fileMenu: pNameDesc;
X  res: resres;
X  scanP: ptrScanRecord;
X
X  function isGoFName(var rName: string): boolean;
X  var
X    ts: string;
X  begin { isGoFName }
X    isGoFName := false;
X    ts := rName;
X    convUpper(ts);
X    if length(ts) < 3 then
X      exit(isGoFName);
X    ts := subStr(ts, length(ts) - 2, 3);
X    if ts = '.GO' then
X      begin
X        rName := subStr(rName, 1, length(rName) - 3);
X        isGoFName := true;
X      end;
X  end { isGoFName };
X
X  handler outside;
X  begin { outside }
X    destroyNameDesc(fileMenu);
X    restoreCursor;
X    menuGoFile := false;
X    write(''); {control-G}
X    exit(menuGoFile);
X  end { outside };
X
Xbegin { menuGoFile }
X  new(scanP);
X  scanP^.initialCall := true;
X  scanP^.dirName := '';
X  prompt('Scanning Directory...');
X  fi := 0;
X  while FSScan(scanP, fName, fid) do
X    if isGoFName(fName) then
X      begin
X        fi := fi + 1;
X        goFNames[fi] := fName;
X      end;
X  dispose(scanP);
X  prompt('');
X  if fi < 1 then
X    begin
X      prompt('No GO files found');
X      menuGoFile := false;
X      exit(menuGoFile);
X    end;
X  allocNameDesc(fi, 0, fileMenu);
X  fileMenu^.header := 'Available Games';
X  for i := 1 to fi do
X    begin
X{$R-}
X      fileMenu^.commands[i] := goFNames[i];
X{$R=}
X    end;
X  menu(fileMenu, false, 1, fi, -1, -1, -1, res);
X  restoreCursor;
X  destroyNameDesc(fileMenu);
X  fName := goFNames[res^.indices[1]];
X  destroyRes(res);
X  menuGoFile := true;
Xend { menuGoFile };
X
Xfunction confirmed: boolean;
X
X  handler outside;
X  begin { outside }
X    confirmed := false;
X    restoreCursor;
X    exit(confirmed);
X  end { outside };
X
Xbegin { confirmed }
X  if treeDirty then
X    begin
X      menu(cnfDesc, false, 1, 2, -1, -1, -1, res);
X      restoreCursor;
X      confirmed := res^.indices[1] = 2;
X      destroyRes(res);
X    end
X  else
X    confirmed := true;
Xend { confirmed };
X
Xprocedure activate(cmd: integer; act: boolean);
Xvar
X  dFun: lineStyle;
Xbegin { activate }
X  with mItems[cmd] do
X    begin
X      isAct := act;
X      if isAct then
X        dFun := drawLine
X      else
X        dFun := eraseLine;
X      line(dFun, leftX, topY, rightX, topY, SScreenP);
X      line(dFun, leftX, botY, rightX, botY, SScreenP);
X      line(dFun, leftX, topY, leftX, botY, SScreenP);
X      line(dFun, rightX, topY, rightX, botY, SScreenP);
X    end;
Xend { activate };
X
Xfunction findItem(x, y: integer): integer;
Xvar
X  i: integer;
Xbegin { findItem }
X  for i := 1 to mLast do
X    with mItems[i] do
X      if isAct then
X        if (x >= leftX) and (x <= rightX) and
X           (y >= topY) and (y <= botY) then
X          begin
X            findItem := i;
X            exit(findItem);
X          end;
X  findItem := none;
Xend { findItem };
X
Xprocedure invertItem(cmd: integer);
Xbegin { invertItem }
X  with mItems[cmd] do
X    rasterop(rNot, mWidth - 2, mHeight - 2,
X                   leftX + 1, topY + 1, SScreenW, SScreenP,
X                   leftX + 1, topY + 1, SScreenW, SScreenP);
Xend { invertItem };
X
Xprocedure checkHighLight;
Xvar
X  cmd: integer;
Xbegin { checkHighLight }
X  cmd := findItem(tabXPos, tabYPos);
X  if cmd <> curHiLi then
X    begin
X      if curHiLi <> none then
X        invertItem(curHiLi);
X      if cmd <> none then
X        invertItem(cmd);
X      curHiLi := cmd;
X    end;
Xend { checkHighLight };
X
Xprocedure writeMStr(cmd, cFunc: integer);
Xbegin { writeMStr }
X  SChrFunc(cFunc);
X  with mItems[cmd] do
X    begin
X      SSetCursor(leftX + 9, botY - 2);
X      write(str);
X    end;
X  SChrFunc(rRpl);
Xend { writeMStr };
X
Xprocedure xorGrey(cmd: integer);
Xbegin { xorGrey }
X  if (cmd <> none) and (cmd <= mLast) then
X    with mItems[cmd] do
X      rasterop(rXor, mWidth - 2, mHeight - 2,
X                     leftX + 1, topY + 1, SScreenW, SScreenP,
X                     0, 0, grWidth, mGreyP);
Xend { xorGrey };
X
Xprocedure selItem(cmd: integer);
Xbegin { selItem }
X  xorGrey(cmd);
X  writeMStr(cmd, rOr);
Xend { selItem };
X
Xprocedure deSelItem(cmd: integer);
Xbegin { deSelItem }
X  xorGrey(cmd);
X  writeMStr(cmd, rAndNot);
Xend { deSelItem };
X
Xprocedure setMenuCursor;
Xbegin { setMenuCursor }
X  if not isMenuCursor then
X    begin
X      IOLoadCursor(defaultCursor, 0, 0);
X      isMenuCursor := true;
X    end;
Xend { setMenuCursor };
X
Xfunction getMenuCmd: integer;
Xvar
X  cmd, nCmd: integer;
X  gOn: boolean;
Xbegin { getMenuCmd }
X  tabXPos := tabRelX;
X  tabYPos := tabRelY;
X  with winTable[boardWin] do
X    if (tabXPos >= winLX) and (tabXPos <= winRX) and
X       (tabYPos >= winTY) and (tabYPos <= winBY) then
X      begin
X        if isMenuCursor then
X          IOLoadCursor(selCursor, curC, curC);
X        isMenuCursor := false;
X      end
X    else
X      setMenuCursor;
X  checkHighLight;
X  if not tabSwitch then
X    curCmd := none
X  else if tabWhite then
X    begin
X      with mItems[mBackOne] do
X        if isAct then
X          begin
X            cmd := mBackOne;
X            if curHiLi <> cmd then
X              begin
X                if curHiLi <> none then
X                  invertItem(curHiLi);
X                invertItem(cmd);
X              end;
X            curHiLi := cmd;
X            curCmd := cmd;
X            selItem(cmd);
X          end
X        else
X          write(''); {control-G}
X      waitNoButton;
X    end
X  else if tabGreen then
X    begin
X      with mItems[mForOne] do
X        if isAct then
X          begin
X            cmd := mForOne;
X            if curHiLi <> cmd then
X              begin
X                if curHiLi <> none then
X                  invertItem(curHiLi);
X                invertItem(cmd);
X              end;
X            curHiLi := cmd;
X            curCmd := cmd;
X            selItem(cmd);
X          end
X        else
X          write(''); {control-G}
X      waitNoButton;
X    end
X  else { tabYellow or tabBlue }
X    begin
X      cmd := findItem(tabXPos, tabYPos);
X      if cmd <> none then
X        begin
X          selItem(cmd);
X          gOn := true;
X          while tabSwitch do
X            begin
X              nCmd := findItem(tabRelX, tabRelY);
X              if nCmd <> cmd then
X                begin
X                  if gOn then
X                    deSelItem(cmd);
X                  gOn := false;
X                end
X              else
X                begin
X                  if not gOn then
X                    selItem(cmd);
X                  gOn := true;
X                end;
X            end;
X          if gOn then
X            begin
X              curCmd := cmd;
X            end
X          else
X            begin
X              write(''); {control-G}
X              curCmd := none;
X            end;
X          waitNoButton;
X        end
X      else
X        with winTable[boardWin] do
X          if (tabXPos >= winLX) and (tabXPos <= winRX) and
X             (tabYPos >= winTY) and (tabYPos <= winBY) then
X            curCmd := mPlaceStone
X          else
X            begin
X              write(''); {control-G}
X              curCmd := none;
X              waitNoButton;
X            end;
X    end;
X  getMenuCmd := curCmd;
Xend { getMenuCmd };
X
Xprocedure endCmd;
Xbegin { endCmd }
X  if (curCmd <> none) and (curCmd <= mLast) then
X    deSelItem(curCmd);
X  curCmd := none;
Xend { endCmd };
X
Xprocedure putMString(cmd: integer; ms: string);
Xbegin { putMString }
X  if (curCmd = cmd) and (cmd <= mLast) then
X    begin
X      deSelItem(cmd);
X      curCmd := none;
X    end;
X  with mItems[cmd] do
X    begin
X      rasterOp(rAndNot, mWidth - 2, mHeight - 2,
X               leftX + 1, topY + 1, SScreenW, SScreenP,
X               leftX + 1, topY + 1, SScreenW, SScreenP);
X      str := ms;
X      writeMStr(cmd, rRpl);
X      if curHiLi = cmd then
X        invertItem(cmd);
X    end;
Xend { putMString };
X
Xprocedure initMenu;
Xvar
X  i, j: integer;
X
X  procedure setItem(cmd, sx, sy: integer; cs: string);
X  begin { setItem }
X    with mItems[cmd] do
X      begin
X        leftX := (sx * mHSpacing) + mLBorder + mWinX;
X        topY := (sy * mVSpacing) + mTBorder + mWinY;
X        isAct := false;
X        rightX := leftX + mWidth - 1;
X        botY := topY + mHeight - 1;
X        putMString(cmd, cs);
X      end;
X  end { setItem };
X
Xbegin { initMenu }
X  curHiLi := none;
X  curCmd := none;
X  setItem(mPass, 0, 0, 'Pass');
X  setItem(mAutoPlay, 0, 1, 'Generate Move');
X  setItem(mPlayMyself, 0, 2, 'Play Myself');
X  setItem(mSetPlayLevel, 0, 3, 'Set Play Level');
X  setItem(mSetHC, 0, 4, 'Set Handicap');
X  setItem(mScore, 0, 5, 'Score');
X  setItem(mQuit, 0, 6, 'Quit');
X  setItem(mInit, 0, 7, 'Initialize');
X  setItem(mBackOne, 1, 0, 'Backup One');
X  setItem(mGotoRoot, 1, 1, 'Back to Start');
X  setItem(mBackToBr, 1, 2, 'Back to Branch');
X  setItem(mBackToStone, 1, 3, 'Back to Stone');
X  setItem(mEraseMove, 1, 4, 'Erase Move');
X  setItem(mPruneBranches, 1, 5, 'Prune Branches');
X  setItem(mDebug, 1, 6, 'Turn Debug On');
X  setItem(mWriteFile, 1, 7, 'Write File');
X  setItem(mForOne, 2, 0, 'Forward One');
X  setItem(mForToLeaf, 2, 1, 'Forward to Leaf');
X  setItem(mForToBr, 2, 2, 'Forward to Branch');
X  setItem(mStepToTag, 2, 3, 'Step Towards Tag');
X  setItem(mGotoTag, 2, 5, 'Go To Tag');
X  setItem(mRefBoard, 2, 6, 'Refresh Board');
X  setItem(mReadFile, 2, 7, 'Read File');
X  setItem(mPutTag, 3, 0, 'Put Tag');
X  setItem(mPutCmt, 3, 1, 'Put Comment');
X  setItem(mSetStepTag, 3, 2, 'Set Step Tag');
X  setItem(mShoState, 3, 3, 'Show Player State');
X  setItem(mTogNums, 3, 4, 'Show Stone Numbers');
X  setItem(mBoardSize, 3, 5, 'Use Small Board');
X  setItem(mPrintBoard, 3, 6, 'Print Board');
X  setItem(mPrintDiag, 3, 7, 'Print Diagram');
X  initPopUp;
X  allocNameDesc(8, 0, valDesc);
X  with valDesc^ do
X    begin
X{$R-}
X      header := 'How Many?';
X      commands[1] := '2';
X      commands[2] := '3';
X      commands[3] := '4';
X      commands[4] := '5';
X      commands[5] := '6';
X      commands[6] := '7';
X      commands[7] := '8';
X      commands[8] := '9';
X{$R=}
X    end;
X  allocNameDesc(2, 0, cnfDesc);
X  with cnfDesc^ do
X    begin
X      header := 'Confirm';
X{$R-}
X      commands[1] := 'No';
X      commands[2] := 'Yes';
X{$R=}
X    end;
X  new(0, 4, mGreyP);
X  i := 0;
X  repeat
X    for j := 0 to (grWidth - 1) do
X      case (i mod 4) of
X        0, 2:
X          mGreyP^[i, j] := #177777;
X        1:
X          mGreyP^[i, j] := #125252;
X        3:
X          mGreyP^[i, j] := #052525;
X      end;
X    i := i + 1;
X  until i > (grHeight - 1);
X  isMenuCursor := true;
Xend. { initMenu }
X
END_OF_goMenu.pas
echo shar: 9 control characters may be missing from \"goMenu.pas\"
if test 16045 -ne `wc -c <goMenu.pas`; then
    echo shar: \"goMenu.pas\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 5 \(of 5\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 5 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0